open Fr
open FrGui
open Printf
IFDEF CAIRO THEN open Cairo END

let dynamic_label t = collapse_w (lift1 label t)

let _ =
	let basic_demo =
		let entry, text =
			text_entry "Enter some text here"
		and password_entry, password =
			text_entry ~visible: (lift false) "" in
		let colorspace_group, colorspace =
			radio_button_group [
				"RGB", ["Red"; "Green"; "Blue"];
				"ROYGBIV", ["Red"; "Orange"; "Yellow"; "Green"; "Blue"; "Indigo"; "Violet"];
				"MYC", ["Magenta"; "Yellow"; "Cyan"]] [] in
		let colors_box, colors =
			list_box (fun s -> s) colorspace []
		and color_box, color =
			scollapse_wb "" (lift (combo_box_entry @colorspace)) in
		let combo_test, combo_val =
			combo_box (fun s -> s) ["One"; "Two"; "Three"] "Two" in
		vbox [
			label "This is a \nmultiline label.";
			entry;
			hbox [label "Here it is: "; text_view text];
			hbox [label "Password: "; password_entry];
			dynamic_label (lift
				(if String.length @password > 0 then
					"Your password is \"" ^ @password ^ "\"!"
				else ""));
			hbox [vbox colorspace_group; colors_box; dynamic_label
				(lift ("You picked: " ^ (String.concat ", " @colors)))];
			hbox [combo_test; dynamic_label combo_val];
			hbox [color_box; text_view color];
		]
	and layout_demo =
		let col1 = width_constraint ()
		and col2 = width_constraint () in
		vbox [
			sized_hbox [
				label ~justification: `Right "short", col1;
				label ~justification: `Left "really loooooooooooong", col2];
			sized_hbox [
				label ~justification: `Right "reaaaaaaaaaly long", col1;
				label ~justification: `Left "small", col2];
			hflow (List.map label [
				"This"; "is"; "a"; "flow"; "box"; "let"; "us"; "see";
				"how"; "many"; "text"; "items"; "we"; "can"; "fit"; "into";
				"one"; "line"; "before"; "it"; "overflows"; "onto"; "the";
				"next"; "line"; "or"; "even"; "next"; "two"; "lines"])
		]
	and text_area_demo =
		let log_box, log_message = text_entry "Log this"
		and log_button, log_event = button ~label: "Log" () in
		vbox [
			text_area_view
				(lift "This is a text area.\n\
					Notice how you can have lots of text in it.\n\
					Multiple lines!");
			hbox [log_box; log_button];
			log_area (snapshot_b log_message log_event);
		]
	and image_demo =
		image_label Images.error
	and dialog_demo =
		let alert_text_box, alert_text = text_entry "Warning!"
		and alert_button, display_alert =
			button ~label: "Alert" ~icon: Images.warning () in
		ignore (register_e (on (snapshot_b alert_text display_alert) ->
			alert
				~parent: alert_button
				~title: "Alert test"
				~okay: "Acknowledged"));
		(*let message_text_box, message_text = text_entry "foo.txt"
		and message_button, display_message = button ~label: "Message Box" () in
		let message_event =
			on (snapshot_b message_text display_message) file ->
				let delete = Some file in
				let test_box, test = button ~label: "test" "hi" in
				let h = register_e (on test s -> print_endline s; flush stdout) in
				let r = message_box
					~parent: message_button
					~default: delete
					(vbox [label (sprintf "Delete file %s?" file); test_box])
					["Delete", delete; "Cancel", None] None in
				unregister h; r in
		let message_label =
			switch_w empty
				(on (may_e message_event) file ->
					label (sprintf "Deleted %s!" file)) in
		ignore (register_e (on (may_e message_event) file -> print_endline file; flush stdout));*)
		let property_button, property_visible = toggle_button ~label: "Show properties" false in
		let make_property_widget i =
			let property_box, property = text_entry i in
			hbox [label "Text:"; property_box], property in
		let property_window, (_, property) =
			swindow
				~visible: property_visible
				make_property_widget "Edit me!" in
		show (lift [property_window]);
		let property_label = collapse_w (lift (label @property)) in
		vbox [
			hbox [alert_text_box; alert_button];
			(*hbox [message_text_box; message_button];
			message_label;*)
			hbox [property_label; property_button];
		]
	and input_demo =
IFDEF CAIRO THEN
		let string_of_button = function
			| `Left -> "Left"
			| `Middle -> "Middle"
			| `Right -> "Right"
			| `Button n -> sprintf "Button %i" n
		and string_of_modifier = function
			| `Shift -> "Shift"
			| `Control -> "Control"
			| `Meta -> "Meta"
			| `Caps -> "Caps"
			| `Mod n -> sprintf "Mod %i" n
		in
		let area, input = FrCairo.canvas (lift ignore) in
		let @pointer_label = label (match @(input#pointer) with
			| Some (x, y) -> sprintf "%.0f, %.0f" x y
			| None -> sprintf "outside window")
		and @buttons_label = label (String.concat ", "
			(List.map string_of_button @(input#buttons)))
		and @click_label = label
			@(hold "" (map_e string_of_button input#click))
		and @scroll_label = label
			(sprintf "%i, %i"
				@(collect_b (fun i -> function `West -> i - 1 | `East -> i + 1 | _ -> i) 0 input#scroll)
				@(collect_b (fun i -> function `North -> i - 1 | `South -> i + 1 | _ -> i) 0 input#scroll))
		and @modifiers_label = label (String.concat ", "
			(List.map string_of_modifier @(input#modifiers)))
		in vbox [
			frame area;
			hbox [label "Pointer: "; collapse_w pointer_label];
			hbox [label "Buttons: "; collapse_w buttons_label];
			hbox [label "Click: "; collapse_w click_label];
			hbox [label "Scroll: "; collapse_w scroll_label];
			hbox [label "Modifiers: "; collapse_w modifiers_label];
		]
ELSE
		label "FrCairo not installed"
END
	and drawing_area_demo =
IFDEF GTK THEN
		let color_box, color = text_entry "black" in
		let font = Gdk.Font.load "-*-helvetica-medium-r-normal-*-*-100-100-100-*-*-iso8859-1" in
		let @redraw input = fun (c: GDraw.drawable) ->
			let w, h = @(input#size) in
			(try c#set_foreground (`NAME @color)
			with _ -> c#set_foreground `BLACK);
			c#string @color ~font ~x: 50 ~y: 50;
			c#rectangle ~x: 0 ~y: 0
				~width: (w - 1)
				~height: (h - 1) ();
			if List.mem `Left @(input#buttons) then
			(match @(input#pointer) with None -> () | Some (x, y) ->
				c#rectangle
					~x: (x - 10)
					~y: (y - 10)
					~width: 21
					~height: 21
					~filled: true ())
		in
		vbox [
			hbox [label "Color: "; color_box];
			fst (fix_wb redraw FrGtk.drawing_area);
		]
ELSE
		label "FrGtk not installed"
END
	and cairo_demo =
IFDEF CAIRO THEN
		let color_box, color = text_entry "black" in
		let redraw input =
			let stuff = collect_b (fun s -> function
				| `Char c -> s ^ (String.make 1 c)
				| `Enter -> ""
				| `Backspace ->
					if String.length s > 0 then
						String.sub s 0 (String.length s - 1)
					else s
				| _ -> s) "" input#keypress
			and size = collect_b (fun s -> function
				| `North -> min (s *. 1.1) 8.0
				| `South -> max (s /. 1.1) 0.125
				| _ -> s) 1.0 input#scroll in
			lift (fun c ->
			let w, h = @(input#size) in
			scale c @size @size;
			set_line_width c 1.0;
			set_source_rgb c 0. 0. 0.;

			rectangle c 0.5 0.5 (w -. 1.) (h -. 1.);
			stroke c;
			
			if List.mem `Left @(input#buttons) then
			begin match @(input#pointer) with None -> () | Some (x, y) ->
				let size =
					@(collect_b (fun i ->
						function
						| `North -> i -. 1.
						| `South -> i +. 1.
						| _ -> i)
						0. input#scroll) in
				rectangle c
					(x -. size /. 2.) (y -. size /. 2.)
					size size;
				fill c;
			end;
			
			move_to c 50. 50.;
			show_text c @color;
			
			move_to c 50. 75.;
			show_text c @stuff;
			if @(collect_b (fun b _ -> not b) false (every 0.5)) then
				begin let extents = font_extents c in
					rel_move_to c 0.5 extents.descent;
					rel_line_to c 0. (~-. (extents.ascent +. extents.descent));
				end;
			stroke c)
		in
		let area, _ = fix_b (fun (w, i) -> redraw i) FrCairo.canvas in
		vbox [
			hbox [label "Color: "; color_box];
			area
		]
ELSE
		label "FrCairo not installed"
END
	and gl_demo =
IFDEF GL THEN
		let redraw () =
			GlDraw.viewport 0 0 200 200;
			GlMat.mode `projection;
			GlMat.load_identity ();
			GlMat.ortho (0., 200.) (200., 0.) (-1., 1.);
			GlMat.mode `modelview;
			GlMat.load_identity ();
			
			GlClear.color (0., 0., 0.);
			GlClear.clear [`color];
			GlDraw.color (1., 1., 1.);
			GlDraw.begins `lines;
			 GlDraw.vertex2 (10., 10.);
			 GlDraw.vertex2 (100., 100.);
			GlDraw.ends ()
		in FrGl.gl_area (lift redraw)
ELSE
		label "FrGl not installed"
END
	and time_demo =
		let clock = collect_b (+.) 0. (every 0.1) in
		hbox [label "Time since program start:"; text_view (lift1 string_of_float clock)]
	in
	let quit_action, quit_event = action "Quit" () in
	let file_menu = group [quit_action] in
	let about_action, about_event = action "About" () in
	let help_menu = group [
		about_action;
		fst (action ~icon: Images.help "Help..." ())] in
	
	let main_widget =
		tabbed ~position: `West ~init: basic_demo [
			"Basic widgets", basic_demo;
			"Layout", layout_demo;
			"Text area", text_area_demo;
			"Image", image_demo;
			"Dialogs", dialog_demo;
			"Input demo", input_demo;
			"GtkDrawingArea", drawing_area_demo;
			"Cairo", cairo_demo;
			"Gl", gl_demo;
			"Time", time_demo;
		] in
	ignore (register_e (on about_event () ->
		alert
			~parent: main_widget
			~title: "About"
			~icon: Images.info
			"FrGui test program v0.1"));

	let main_toolbar = vtoolbar ~large: true ~text: true (group [
			fst (action ~icon: Images.new_file "New" ());
			fst (action ~icon: Images.open_file "Open" ());
			fst (action ~icon: Images.save "Save" ());
			fst (action ~icon: Images.save_as ~tooltip: "Save a file with a new name" "Save As" ());
		]) in
			
	let main_window, close = window
		~label: "ORT demonstration"
		~menu_bar: (join_groups [group [submenu "File" file_menu]; group [submenu "Help" help_menu]])
		~status_bar: (hbox [label "This is the status!"; empty])
		(hbox [main_widget; main_toolbar]) in
	run_window (main_window, merge_e [close; quit_event])
